SPACE 1/SPACE - Library 1 - Volume 1.iso/program/355/source/ifsdemo/gemprocs.mod

Text File | 1990-02-02 | 6KB | 227 lines

IMPLEMENTATION MODULE GEMProcs;

FROM SYSTEM IMPORT ADDRESS;

FROM AESApplications IMPORT ApplInit,
                            ApplExit;

FROM AESForms IMPORT FormAlert,
                     FormCenter,
                     FormDial,
                     FormDo;

FROM AESGraphics IMPORT GrafMouse,
                        GrafHandle;

FROM AESObjects IMPORT ObjcDraw;

FROM AESResource IMPORT RsrcGAddr,
                        RsrcFree,
                        RsrcLoad;

FROM AESWindows IMPORT WindUpdate;

FROM GEMConstants IMPORT BEGUPDATE,
                         ENDUPDATE,
                         ARROW,
                         BUSYBEE,
                         MOFF,
                         MON,
                         FMDSTART,
                         FMDGROW,
                         FMDSHRINK,
                         FMDFINISH,
                         NORMAL;

FROM GEMTypes IMPORT GRECT,
                     OBJECT;

FROM VDIControl IMPORT WorkIn,
                       WorkOut,
                       Handle,
                       VClsVwk,
                       VOpnVwk;

FROM VDIQuery IMPORT VqExtnd;

FROM XBIOSScreen IMPORT getRez;

TYPE Tree = POINTER TO ARRAY [1..200] OF OBJECT;

VAR dummy : INTEGER;

PROCEDURE SetScreenAttr();

BEGIN
   VqExtnd(Handle,0,WorkOut);
   GEMState.xmax := WorkOut[0];
   GEMState.ymax := WorkOut[1];
   GEMState.rez := getRez();
   IF GEMState.rez < 2 THEN
      GEMState.iscolor := TRUE;
   ELSE
      GEMState.iscolor := FALSE;
   END;
   GEMState.mhidden := FALSE;
END SetScreenAttr;

PROCEDURE GEMInit(rscname : ADDRESS) : BOOLEAN;

BEGIN
   GEMState.apid := ApplInit();
   IF GEMState.apid < 0 THEN
      dummy := FormAlert(1,'[1][ ApplInit | Error ??? ][ Abort ]');
      GEMState.level := 0;
   ELSE
      GEMState.handle := GrafHandle(GEMState.wchar,GEMState.hchar,
                                    GEMState.wbox,GEMState.hbox);
      Handle := GEMState.handle;
      VOpnVwk(WorkIn,Handle,WorkOut);
      IF Handle = 0 THEN
         dummy := FormAlert(1,'[1][ VOpnVwk | Error ??? ][ Abort ]');
         GEMState.level := 1;
      ELSIF rscname # NIL THEN
         GEMState.hasrsc := TRUE;
         dummy := WindUpdate(BEGUPDATE);
         dummy := GrafMouse(BUSYBEE,NIL);
         SetScreenAttr;
         IF RsrcLoad(rscname) = 0 THEN
            dummy := GrafMouse(ARROW,NIL);
            dummy := FormAlert(1,'[1][ form.rsc | not found ][ Abort ]');
            dummy := WindUpdate(ENDUPDATE);
            GEMState.level := 2;
         ELSE
            dummy := GrafMouse(ARROW,NIL);
            dummy := WindUpdate(ENDUPDATE);
            GEMState.level := 3;
         END;
      ELSE
         GEMState.hasrsc := FALSE;
         GEMState.level := 3;
      END;
   END;
   IF GEMState.level = 3 THEN
      RETURN TRUE;
   ELSE
      RETURN FALSE;
   END;
END GEMInit;

PROCEDURE GEMTerm();

BEGIN
   IF GEMState.level > 0 THEN
      IF GEMState.level > 1 THEN
         IF GEMState.level > 2 THEN
            IF GEMState.hasrsc THEN
               dummy := RsrcFree();
            END;
         END;
         VClsVwk(Handle);
      END;
      dummy := ApplExit();
   END;
END GEMTerm;

PROCEDURE HideMouse();

BEGIN
   IF NOT GEMState.mhidden THEN
      dummy := GrafMouse(MOFF,NIL);
      GEMState.mhidden := TRUE;
   END;
END HideMouse;

PROCEDURE ShowMouse();

BEGIN
   IF GEMState.mhidden THEN
      dummy := GrafMouse(MON,NIL);
      GEMState.mhidden := FALSE;
   END;
END ShowMouse;

PROCEDURE Min(a,b : INTEGER) : INTEGER;

BEGIN
   IF a > b THEN
      RETURN b;
   ELSE
      RETURN a;
   END;
END Min;

PROCEDURE Max(a,b : INTEGER) : INTEGER;

BEGIN
   IF a > b THEN
      RETURN a;
   ELSE
      RETURN b;
   END;
END Max;

PROCEDURE RectIntersect(rect1     : GRECT;
                        VAR rect2 : GRECT) : BOOLEAN;

VAR tx,ty,tw,th : INTEGER;

BEGIN
   tw := Min(rect2.x + rect2.w,rect1.x + rect1.w);
   th := Min(rect2.y + rect2.h,rect1.y + rect1.h);
   tx := Max(rect2.x,rect1.x);
   ty := Max(rect2.y,rect1.y);
   rect2.x := tx;
   rect2.y := ty;
   rect2.w := tw - tx;
   rect2.h := th - ty;
   IF ((tw > tx) AND (th > ty)) THEN
      RETURN TRUE;
   ELSE
      RETURN FALSE;
   END;
END RectIntersect;

PROCEDURE DoDialog(boxindex : INTEGER);

VAR xbox,ybox,wbox,hbox         : INTEGER;
    smallx,smally,smallw,smallh : INTEGER;
    exitobject                  : INTEGER;
    boxaddr                     : Tree;

BEGIN
   dummy := RsrcGAddr(0,boxindex,boxaddr);
   dummy := FormCenter(boxaddr,xbox,ybox,wbox,hbox);
   smallx := xbox + (wbox DIV 2);
   smally := ybox + (hbox DIV 2);
   smallw := 0;
   smallh := 0;
   dummy := FormDial(FMDSTART,smallx,smally,smallw,smallh,
                              xbox,ybox,wbox,hbox);
   dummy := FormDial(FMDGROW,smallx,smally,smallw,smallh,
                             xbox,ybox,wbox,hbox);
   dummy := ObjcDraw(boxaddr,0,10,xbox,ybox,wbox,hbox);
   exitobject := FormDo(boxaddr,0);
   dummy := FormDial(FMDSHRINK,smallx,smally,smallw,smallh,
                               xbox,ybox,wbox,hbox);
   dummy := FormDial(FMDFINISH,smallx,smally,smallw,smallh,
                               xbox,ybox,wbox,hbox);
   boxaddr^[exitobject].state := NORMAL;
END DoDialog;

PROCEDURE AddrToInts(addr      : ADDRESS;
                     VAR i1,i2 : INTEGER);

TYPE TWOINTS = ARRAY [0..1] OF INTEGER;

VAR temp : TWOINTS;

BEGIN
   temp := VAL(TWOINTS,addr);
   i1 := temp[0];
   i2 := temp[1];
END AddrToInts;

BEGIN
END GEMProcs.